home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO001.dsk / ORGANIC.CHEM.bas < prev    next >
BASIC Source File  |  2012-02-16  |  7KB  |  152 lines
  1. 100  DIM CP(15,2),OP(6,2),HP(34,2)
  2. 110  DIM C(15,4),O(6,2)
  3. 115  SPEED= 255: NORMAL : PRINT  CHR$(21)
  4. 120  TEXT : HOME : VTAB 5: PRINT "   O R G A N I C   C H E M I S T R Y": VTAB 10
  5. 138  PRINT "THIS PROGRAM WILL DRAW A MOLECULE": PRINT "FOR A GIVEN MOLECULAR FORMULA."
  6. 140  PRINT : PRINT : PRINT 
  7. 150  PRINT "WHAT NUMBER OF CARBON, HYDROGEN, AND": PRINT "OXYGEN ATOMS ARE IN THE MOLECULE?"
  8. 160  PRINT : INPUT " HOW MANY CARBON   (0-16): ";NC:NC =  INT(NC)
  9. 162  IF NC <0  OR NC >16 GOTO 160
  10. 163  PRINT " HOW MANY HYDROGEN (2-"2 +NC +NC;: INPUT "): ";NH:NH =  INT(NH)
  11. 166  IF NH < >2 * INT(NH/2)  THEN  PRINT " * USE AN EVEN NUMBER OF HYDROGEN.": GOTO 163
  12. 167  IF NH <0  OR NH >2 +NC +NC GOTO 163
  13. 170  INPUT " HOW MANY OXYGEN   (0-7):  ";NO:NO =  INT(NO)
  14. 175  IF NO <0  OR NO >7 GOTO 170
  15. 210 EU = ((2 *NC +2) -NH)/2
  16. 220  FOR I = 1 TO NC: FOR J = 1 TO 4:C(I,J) = 0: NEXT J,I
  17. 230  FOR I = 1 TO NO: FOR J = 1 TO 2:O(I,J) = 0: NEXT J,I
  18. 240 HU = 0:OU = 0:UN = 0
  19. 250  IF NC = 1  THEN 340
  20. 260 C(1,1) = 2:C(2,1) = 1: IF NC = 2  THEN 340
  21. 270  FOR I = 3 TO NC
  22. 280 X =  INT( RND(1) *(I -1)) +1
  23. 290  IF C(X,2) = 0  THEN C(I,1) = X:C(X,2) = I: GOTO 330
  24. 300  IF C(X,3) = 0  THEN C(I,1) = X:C(X,3) = I: GOTO 330
  25. 310  IF C(X,4) = 0  THEN C(I,1) = X:C(X,4) = I: GOTO 330
  26. 320  GOTO 280
  27. 330  NEXT I
  28. 340  IF NO = 0  THEN 440
  29. 350  FOR I = 1 TO NO
  30. 360 X =  INT( RND(1) *(NC +I -1)) +1
  31. 370  IF X < = NC  THEN 380: IF O( ABS(X -NC),2) = 0  THEN O(X -NC,2) =  -I:O(I,1) =  -(X -NC): GOTO 430
  32. 380  IF X < = NC  THEN 390: IF O( ABS(X -NC),2) < >0  THEN 360
  33. 390  IF C(X,2) = 0  THEN C(X,2) =  -I:O(I,1) = X: GOTO 430
  34. 400  IF C(X,3) = 0  THEN C(X,3) =  -I:O(I,1) = X: GOTO 430
  35. 410  IF C(X,4) = 0  THEN C(X,4) =  -I:O(I,1) = X: GOTO 430
  36. 420  GOTO 360
  37. 430  NEXT I
  38. 440  IF UN = EU  THEN 540
  39. 450  IF NC = 1  THEN 480
  40. 460  GOSUB 730
  41. 470  IF C(X1,X2) = 0  AND C(Y1,Y2) = 0  THEN C(X1,X2) = Y1:C(Y1,Y2) = X1:UN = UN +1: IF UN = EU  THEN 540
  42. 480  IF NO = 0  THEN 460
  43. 490  GOSUB 750
  44. 500  IF C(X1,X2) = 0  AND O(Y1,2) = 0  THEN C(X1,X2) =  -Y1:O(Y1,2) = X1:UN = UN +1: GOTO 440
  45. 510  IF NO = 1  THEN 440
  46. 520  GOSUB 770
  47. 530  IF O(X1,2) = 0  AND O(Y1,2) = 0  THEN O(X1,2) =  -Y1:O(Y1,2) =  -X1:UN = UN +1: GOTO 440
  48. 540  IF NC = 1  THEN C(1,1) =  -101:HU = HU +1
  49. 550  FOR I = 1 TO NC: FOR J = 2 TO 4
  50. 560  IF C(I,J) = 0  THEN C(I,J) =  -(101 +HU):HU = HU +1
  51. 570  NEXT J,I
  52. 580  IF NO = 0  THEN 620
  53. 590  FOR I = 1 TO NO: IF O(I,2) = 0  THEN O(I,2) =  -(101 +HU):HU = HU +1
  54. 600  NEXT I
  55. 610  IF NH < >HU  THEN 220
  56. 620  GOSUB 780
  57. 630  GOSUB 1180
  58. 640  PRINT "HIT 'D' TO DRAW THIS DIFFERENTLY"
  59. 650  PRINT "HIT 'I' FOR A NEW ISOMER (SAME FORMULA)"
  60. 660  PRINT "HIT 'F' FOR A NEW MOLECULAR FORMULA"
  61. 670  POKE  -16368,0: WAIT  -16384,128
  62. 680  POKE  -16368,0:K$ =  CHR$( PEEK( -16384))
  63. 690  IF K$ = "D" GOTO 620
  64. 700  IF K$ = "I" GOTO 220
  65. 710  IF K$ = "F" GOTO 120
  66. 720  TEXT : HOME : END 
  67. 730 X1 =  INT( RND(1) *NC) +1:Y1 =  INT( RND(1) *NC) +1: IF X1 = Y1  THEN 730
  68. 740 X2 =  INT( RND(1) *3) +2:Y2 =  INT( RND(1) *3) +2: RETURN 
  69. 750 X1 =  INT( RND(1) *NC) +1:Y1 =  INT( RND(1) *NO) +1
  70. 760 X2 =  INT( RND(1) *3) +2: RETURN 
  71. 770 X1 =  INT( RND(1) *NO) +1:Y1 =  INT( RND(1) *NO) +1: IF X1 = Y1  THEN 770: RETURN 
  72. 780  FOR I = 1 TO NC: FOR J = 0 TO 2:CP(I,J) = 0: NEXT J,I
  73. 790  IF NO < >0  THEN  FOR I = 1 TO NO: FOR J = 0 TO 2:OP(I,J) = 0: NEXT J,I
  74. 800 FF = 0:CP(1,1) = 120:CP(1,2) = 75
  75. 810  FOR II = 1 TO NC: IF CP(II,0) = 0  THEN 830
  76. 820  NEXT II: GOTO 1010
  77. 830  FOR I = II TO NC: IF CP(I,0) = 1  OR CP(I,1) = 0  THEN 1000
  78. 840 XX =  INT( RND(1) *4): FOR J = 1 TO 4:KK = 0
  79. 850  IF XX = 0  THEN X = CP(I,1) +20:Y = CP(I,2)
  80. 860  IF XX = 1  THEN X = CP(I,1):Y = CP(I,2) -20
  81. 870  IF XX = 2  THEN X = CP(I,1) -20:Y = CP(I,2)
  82. 880  IF XX = 3  THEN X = CP(I,1):Y = CP(I,2) +20
  83. 890 XX = XX +1: IF XX = 4  THEN XX = 0
  84. 900  IF C(I,J) < -100  THEN HP( ABS(C(I,J) +100),1) = ((X -CP(I,1)) *7/20) +CP(I,1):HP( ABS(C(I,J) +100),2) = ((Y -CP(I,2)) *7/20) +CP(I,2): GOTO 990
  85. 910 TX = X:TY = Y:FF = 0: GOSUB 1100: IF FF =  -1  AND KK <3  THEN KK = KK +1: GOTO 850
  86. 920  IF FF =  -1  AND KK >2  THEN 780
  87. 930  IF NO = 0  THEN 960
  88. 940  IF C(I,J) >0  THEN 970
  89. 950  IF C(I,J) <0  AND C(I,J) > -100  AND OP( ABS(C(I,J)),1) >0  THEN 990
  90. 960  IF C(I,J) <0  AND C(I,J) > -100  THEN OP( ABS(C(I,J)),1) = X:OP( ABS(C(I,J)),2) = Y: GOTO 990
  91. 970  IF CP(C(I,J),1) >0  THEN 990
  92. 980 CP(C(I,J),1) = X:CP(C(I,J),2) = Y
  93. 990  NEXT J:CP(I,0) = 1
  94. 1000  NEXT I: GOTO 810
  95. 1010  IF NO = 0  THEN 1090
  96. 1020  FOR I = 1 TO NO: IF OP(I,1) >0  THEN 1060
  97. 1030  FOR J = 1 TO NO: IF J = I  THEN 1050
  98. 1040  IF O(J,1) =  -I  THEN OP(I,1) = OP(J,1):OP(I,2) = OP(J,2) +20:TX = OP(I,1):TY = OP(I,2):FF = 1: GOSUB 1100: IF FF =  -1  THEN 780
  99. 1050  NEXT J
  100. 1060  IF O(I,1) < -100  THEN HP( ABS(O(I,1) +100),1) = OP(I,1) +7:HP( ABS(O(I,1) +100),2) = OP(I,2)
  101. 1070  IF O(I,2) < -100  THEN HP( ABS(O(I,2) +100),1) = OP(I,1) -7:HP( ABS(O(I,2) +100),2) = OP(I,2)
  102. 1080  NEXT I
  103. 1090  RETURN 
  104. 1100  FOR K = 1 TO NC: IF K = C(I,J)  AND FF = 0  THEN 1120
  105. 1110  IF TX = CP(K,1)  AND TY = CP(K,2)  THEN FF =  -1: GOTO 1170
  106. 1120  NEXT K: IF NO = 0  THEN 1170
  107. 1130  FOR K = 1 TO NO: IF K =  ABS(C(I,J))  AND FF = 0  THEN 1160
  108. 1140  IF K = I  AND FF = 1  THEN 1160
  109. 1150  IF TX = OP(K,1)  AND TY = OP(K,2)  THEN FF =  -1: GOTO 1170
  110. 1160  NEXT K
  111. 1170  RETURN 
  112. 1180  HGR : CALL  -936: VTAB 21: HCOLOR= 3
  113. 1190  FOR I = 1 TO NC: FOR J = 1 TO 4
  114. 1200  IF C(I,J) < -100  THEN  HPLOT CP(I,1),CP(I,2) TO HP( ABS(C(I,J) +100),1),HP( ABS(C(I,J) +100),2): GOTO 1360
  115. 1210  IF C(I,J) >0  THEN 1290
  116. 1220 FF = 0
  117. 1230  FOR K = 1 TO 4: IF K = J  THEN 1250
  118. 1240  IF C(I,K) = C(I,J)  THEN FF =  -1
  119. 1250  NEXT K
  120. 1260  HPLOT CP(I,1),CP(I,2) TO OP( ABS(C(I,J)),1),OP( ABS(C(I,J)),2)
  121. 1270  IF FF =  -1  THEN  HPLOT CP(I,1) +3,CP(I,2) +3 TO OP( ABS(C(I,J)),1) +3,OP( ABS(C(I,J)),2) +3
  122. 1280  GOTO 1360
  123. 1290 FF = 0: IF C(I,J) <I  THEN 1360
  124. 1300  FOR K = 1 TO 4: IF K = J  THEN 1320
  125. 1310  IF C(I,J) = C(I,K)  THEN FF = FF +1
  126. 1320  NEXT K
  127. 1330  HPLOT CP(I,1),CP(I,2) TO CP(C(I,J),1),CP(C(I,J),2)
  128. 1340  IF FF >0  THEN  HPLOT CP(I,1) +3,CP(I,2) +3 TO CP(C(I,J),1) +3,CP(C(I,J),2) +3
  129. 1350  IF FF = 2  THEN  HPLOT CP(I,1) -3,CP(I,2) -3 TO CP(C(I,J),1) -3,CP(C(I,J),2) -3
  130. 1360  NEXT J
  131. 1370  NEXT I
  132. 1380  IF NO = 0  THEN 1450
  133. 1390  FOR I = 1 TO NO: FOR J = 1 TO 2
  134. 1400  IF O(I,J) >0  THEN 1430
  135. 1410  IF O(I,J) < -100  THEN  HPLOT OP(I,1),OP(I,2) TO HP( ABS(O(I,J) +100),1),HP( ABS(O(I,J) +100),2): GOTO 1430
  136. 1420  IF O(I,J) <0  THEN  HPLOT OP(I,1),OP(I,2) TO OP( ABS(O(I,J)),1),OP( ABS(O(I,J)),2)
  137. 1430  NEXT J
  138. 1440  NEXT I
  139. 1450  HCOLOR= 1: FOR I = 1 TO NC
  140. 1460 X = CP(I,1):Y = CP(I,2): GOSUB 1530: NEXT I
  141. 1470  IF NO = 0  THEN 1500
  142. 1480  HCOLOR= 2: FOR I = 1 TO NO
  143. 1490 X = OP(I,1):Y = OP(I,2): GOSUB 1530: NEXT I
  144. 1500  HCOLOR= 3: FOR I = 1 TO NH
  145. 1510 X = HP(I,1):Y = HP(I,2): GOSUB 1560: NEXT I
  146. 1520  RETURN 
  147. 1530  FOR L =  -3 TO 3
  148. 1540  HPLOT X -3,Y +L TO X +3,Y +L
  149. 1550  NEXT L: RETURN 
  150. 1560  FOR L =  -1 TO 1
  151. 1570  HPLOT X -1,Y +L TO X +1,Y +L
  152. 1580  NEXT L: RETURN